perm filename PT2D.F4[NEW,LCS]2 blob
sn#314565 filedate 1977-10-30 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ******* PAGE 2 PT2D.F4 ******* WX
C00022 ENDMK
Cā;
******* PAGE 2 PT2D.F4 ******* WX
SUBROUTINE PT2
DIMENSION BARS(1),JBAR(1),JRN(1),MBAR(1),JTRN(1),PGTRN(1)
1,IBAR(100)
COMMON /FIN/LBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 /MNX/MIN,MAX,JT
COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK(0/7),
1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(0/7) /RSIG/RSIG(0/7)
1 /KBAR/KBAR(1) /RSP/KNM(10),ENDLN,N,NAME,NMPG,T
COMMON RS,JA,RA,R,RB,RQ(15),KQ,NQ,JQ,JJQ,KBQ,NAQ /KNUM/KNUM
1 /STF/RSTFAC(0/7),RSTJ2 /IVV/IV(1) /SIZE/SIZE /ITX/ITX(18)
COMMON /POSI/STFF(0/7),JJ2,JPQ /LLL/L,ITRANS,I,RXQ,XSIG
1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(50)
1/BRJ/JTOT,TURN,NB,DSK
EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
1,(R8,RQ(6)),(R9,RQ(7)),(JRN,RN),(MBAR,RN(1000)),(KA,KBAR(1025))
1,(K,KBAR(1027)),(JTRN,Q),(J,KBAR(1026)),(PGTRN,KBAR(516))
1,(LCNT,IV(45)),(NDPY,IV(46)),(TOT,KBAR(2)),(JBAR,BARS,KBAR(4))
1,(IBAR,Q(3000))
DATA JLINE/250/,HX/2./,ITX/'EF-','E-','F','GF','G','AF','A',
1 'BF','B',0,'DF','D','EF','E','F+','BBF','O-','O+'/,
1 SLSP/11.0/,DIV/4./
INTEGER DSK
C O- = OCTAVE DOWN, O+ =OCTAVE UP. OR 1/2 STEP NUMS. MAY BE USED.
C JLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
C TRNSP'S ALL
145 FORMAT(F,3I)
IF(NAMX.NE.0)GO TO 2000
CALL GETEXT('BARS','PAG')
CALL EXTIN(KBAR,1024)
C STAFF NAMES BEGIN IN KBAR(508) [STFNM(0)7]
CALL EXTIN(RSTFAC,128)
2000 TYPE 144,RSTJ2
144 FORMAT(' STAFF SIZE='F4.2,' CHANGE TO '$)
ACCEPT 145,SIZE,DSK
C TYPE 2ND NUM TO WRITE BARS/LINE DATA ON DSK FILE FOR21.DAT
IF(DSK.NE.0)DSK=-1
XSIG=0
IF(IPG)GO TO 2001
C IF NOT PARTS, INDICATE 1ST PAGE NUM (TO START PAGE NUMS BEYOND 1)
TYPE 2002
2002 FORMAT(' FIRST PAGE NUMBER -- '$)
306 FORMAT(I5,3X8I5)
ACCEPT 306,KNUM
2001 TYPE 304
304 FORMAT(' TRANSP.= '$)
ACCEPT 2101,ITRANS
IF(ITRANS.GT.-20)GO TO 1101
2101 FORMAT(A3)
C NEXT FOR LETTER NAMES
DO 3101 K=1,18
3101 IF(ITRANS.EQ.ITX(K))GO TO 4101
5101 TYPE 240
GO TO 2000
240 FORMAT(' THIS TRANSP NOT OFFERED')
1101 REREAD 306,ITRANS
IF(ITRANS.EQ.0)GO TO 1304
ITRANS=10-ITRANS
IF(ITRANS.EQ.22)ITRANS=17
C FOR DOWN OCT.
IF(ITRANS.GT.0)GO TO 1304
IF(ITRANS.EQ.-2)ITRANS=18
C -2 NOW = UP OCT.
GO TO 1304
4101 ITRANS=K
1304 IF(SIZE.EQ.0)SIZE=RSTJ2
SIZE=SIZE/RSTJ2
CCC IF(TURN.EQ.0)TURN=1000.
101 JTOT=0
C ABOVE ASSUMES FIRST LINE ALWAYS HAS A CLEF.
DO 22 K=1,KT
JJ=BARS(K)*SIZE+.5
JBAR(K)=JJ
22 JTOT=JTOT+JJ
33 IF(RSTJ2.EQ.0)RSTJ2=1
RA=JPG*SIZE*RSTJ2
MPG=10./RA
C MPG=NUM OF BRACES PER PAGE.
RS=SIZE*17
RA=(RSTJ2*SIZE)/RPSZ(1)
DO 141 K=1,JPG
RB=RSTNUM(K)-1
C ADJUSTS DIST. BETWEEN STAVES DEPENDING ON SIZE FACTOR.
RHGT(K)=RHGT(K)+RB*(RS-17)
141 RPSZ(K)=RPSZ(K)*RA
LPG=JPG
RA=0
90 FORMAT(' TOTAL BAR LINES='I3)
91 FORMAT(' NUMBER OF BARS PER LINE')
NPG=MPG
LTOT=JTOT
NB=1
JT=TOT*SIZE
JT=JT/JLINE
C USE JLINE (250 FOR NOW) AS SUGGESTED LINE LENGTH
609 TYPE 2003
2003 FORMAT(' FIND PAGE TURNS? '$)
ACCEPT 2101,K
TURN=1000.
KPG=0
IF(K.NE.'Y')GO TO 140
CALL FNDTRN(RPG,PGTRN,JBAR,IBAR,KT,KB)
IF(IBAR(1).NE.0)GO TO 119
140 TYPE 90,KT
TYPE 91
KPG=0
16 CALL BRJUGL(JBAR(1),KT,NBAR(1),MBAR(1),JRN(1),PGTRN(1)
1,JTRN(1))
RPG=JT
RPG=RPG/MPG
605 TYPE 604,RPG,JT,KT
IF(DSK)WRITE(21,604)RPG,JT,KT
TURN=1000.
NB=1
610 TYPE 608
604 FORMAT(F5.2,' PAGES',/,I4,' LINES',I6,' BARS')
608 FORMAT(/' TYPE LAYOUT NUMBERS(-1=HELP)-- '$)
C FOR 'T' TYPE X Y FOR X PAGES, Y LINES PER PAGE.
KKT=0
KA=0
K=JT
ACCEPT 145,T,N,KL
C TYPE 0,n TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
IF(T)GO TO 700
C GO FOR HELP
IF(KL.NE.0)GO TO 110
C NO MORE THAN 50 NUMS, INCLUDING 0S (FOR PAGE MARKS)
IF(T.EQ.0)GO TO 11
115 JT=T
MPG=NPG
CC IF(T.EQ.JT)GO TO 210
CC MPG=(T-JT)*100.+.5
IF(N.GT.100)GO TO 110
IF(N.EQ.0)GO TO 16
C N=0 MEANS T= NUM OF LINES DESIRED.
MPG=N
C MPG=LINES PER PAGE, JT=TOTAL NUM OF BARS
KPG=MPG
JT=JT*MPG
IF(JT.LE.KT)GO TO 16
C CATCHES REQUEST FOR TOO MANY BARS.
JT=K
606 TYPE 607
GO TO 605
607 FORMAT(' WRONG NUMBER OF BARS')
111 FORMAT(50I)
110 REREAD 111,NBAR
IF(NBAR(2).LT.100)GO TO 911
C NEXT FOR BARS PER PAGE SYSTEM
DO 118 KB=1,100
KP=NBAR(KB)
IF(KP.EQ.0)GO TO 119
118 IBAR(KB)=NBAR(KB)
CC119 DO 112 KB=2,50,2
CC112 IF(IBAR(KB).EQ.0)GO TO 113
C ADDS UP BARS
119 IF(IBAR(KB-2).NE.KT)GO TO 606
C GO BACK IF MISMATCH
MB=0
LB=1
KA=1
RPG=0
114 KKT=IBAR(KA)-MB
NB=MB+1
MB=IBAR(KA)
C RESET MB FOR NEXT TIME AROUND
MPG=IBAR(KA+1)
KP=MPG/100
C GET NUM OF PAGES
MPG=MPG-KP*100
JT=MPG*KP
116 JTOT=0
DO 125 KE=NB,KKT+NB-1
125 JTOT=JTOT+JBAR(KE)
CALL BRJUGL(JBAR(NB),KKT,NBAR(LB),MBAR(NB),JRN(NB),PGTRN(NB)
1,JTRN(NB))
IF(KP.EQ.1)GO TO 122
C DOES ONLY ONE OR TWO PAGE UNITS
124 DO 123 KE=LB+JT+1,LB+MPG+1,-1
123 NBAR(KE)=NBAR(KE-1)
NBAR(LB+MPG)=0
LB=LB+MPG+1
122 KA=KA+2
LB=1+LB+MPG
C UPDATE NBAR COUNTER
1111 RPG=RPG+KP
IF(KA.LT.KB)GO TO 114
JT=MPG*RPG
CC KA=0
JTOT=LTOT
GO TO 605
911 DO 117 K=50,1,-1
KP=NBAR(K)
KA=KA+KP
117 IF(KP.EQ.0.AND.KA.EQ.0)KL=K
IF(KA.NE.KT)GO TO 606
C MISMATCH!
N=26-2*MOD(KL-1,12)
IF(N.EQ.26)N=0
C TO SPACE OUT STAVES VERTICALLY ???
DO 121 K=1,50
121 IF(NBAR(K).EQ.0)GO TO 120
120 MPG=K-1
CC11 SPG=10./MPG
C MPG=NUM OF BRACES PER PAGE.
C SPG IS SPACE TO BE SET ABOVE STAFF 0
11 MPG=KPG
CALL WRTPAG
700 IF(T.LT.-1)GO TO 609
C TYPE -2 TO GET BACK 'PAGE TURN' MODE
TYPE 701
TYPE 90,KT
GO TO 610
701 FORMAT(' FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE'//
1' A SINGLE NUMBER = NUMB. OF LINES ONLY.'//
1' TYPE X,Y FOR X PAGES, Y LINES PER PAGE.'/
1' 2,5=2 PAGES, 5 LINES, 4,10=4 PAGES, 10 LINES, ETC.'//
1' M1,M2,...0 N1,N2,...0 = ZEROS ARE PAGE MARKS.'/
1' N''S ARE NUMB. OF BARS PER LINE.'//
1' N X0A M Y0B K Z0C ETC. = '/
1' A = NUM OF LINES/PAGE, N=NUMB OF BARS/PAGE(S),
1 X =NUMB OF PAGES.'/
1' EXAMPLE: 40 208 = 8 LINES/PAGE, 40 BARS ON 2 PAGES.'//
1' NEGATIVE NUMBS IN BAR LIST ARE POSSIBLE PAGE TURN POINTS.'/
1' TYPE -2 TO RETURN TO "PAGE TURN" MODE.'/)
CCC 1' 0 N = EXITS WITH N" SPACE BETWEEN STAVES.'//
END
CC SUBROUTINE MINMAX
CC COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
CC MIN=10000
CC MAX=0
CC DO 107 K=1,JT
CC NN=JRN(K)
CC IF(NN.LT.MIN)MIN=NN
CC107 IF(NN.GT.MAX)MAX=NN
CC END
CC SUBROUTINE STORE
CC COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)/NBAR/NBAR(1)
CC DIMENSION MB(1)
CC EQUIVALENCE (MB,JRN(1000))
CC DO 1 K=2,JT+1
CC1 MB(K)=NBAR(K)
CC END